home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / egavga.swg / 0162_Mono PCX Viewer.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  3.3 KB  |  112 lines
  1. {
  2. With this program you can view monocrome pcx files, smaller than 60KB. It
  3. will only work on VGA cards.
  4.  
  5. A Program to view monocrome PCX files
  6.  
  7. A MacSoft production in 1994 by Andreas Oestlund
  8. }
  9. Type
  10.     TPCX_Header = Record
  11.                         Manufacturer   : Byte;                {always A0h }
  12.                         Version        : Byte;                {version }
  13.                         Encoding       : Byte;                {always 1}
  14.                         Bits_Per_Pixel : Byte;                {color bits}
  15.                         XMin,YMin      : Word;                {image origin}
  16.                         XMax,YMax      : Word;                {dimensions}
  17.                         HRes           : Word;                {resolution val}
  18.                         VRes           : Word;                {}
  19.                         Palette        : Array[1..48] Of Byte;{palette}
  20.                         Reserved       : Byte;                {}
  21.                         Color_Planes   : Byte;                {color planes}
  22.                         Bytes_Per_Line : Word;                {line buffer
  23. size}                        Palette_Type   : Word;                {gray or
  24. color pal}                        Filler         : Array[1..58] Of Byte;{}
  25.                   End;
  26.  
  27.     TPCXData    = Array[1..60000] Of Byte;
  28.  
  29. Procedure SetMode (m : Byte); Assembler;
  30.      Asm
  31.           Mov  AH, 0
  32.           Mov  AL, m
  33.           Int  10h
  34.      End;
  35.  
  36. Var
  37.    Header     : TPCX_Header;
  38.    F          : File;
  39.    B,C        : Byte;
  40.    Line_Table : Array[0..479] Of Word;
  41.    PcxData    : ^TPcxData;
  42.  
  43.    Width,
  44.    Height,
  45.    Bytes_Per_Line : Word;
  46.  
  47.    NuRead         : Word;
  48.  
  49. Procedure Decode_PCX_Line (l : Word);
  50. Var
  51.    i,j      : Word;
  52.  
  53. Const
  54.      Data_NDX : Word = 0;
  55.  
  56.      Begin
  57.           i := 0;
  58.           While i < Bytes_Per_Line Do
  59.               Begin
  60.                    Inc (Data_NDX);
  61.                    B := PcxData^[Data_NDX];
  62.  
  63.                    If (B And $C0) = $C0 Then
  64.                     Begin
  65.                          B := B And $3F;
  66.  
  67.                          Inc (Data_NDX);
  68.                          C := PcxData^[Data_NDX];
  69.                          For j := 1 To B Do
  70.                            Begin
  71.                                 Mem[$A000:Line_Table[l]+i] := C;
  72.                                 Inc (i);
  73.                            End;
  74.                     End
  75.                    Else
  76.                        Begin
  77.                             Mem[$A000:Line_Table[l]+i] := B;
  78.                             Inc (i);
  79.                        End;
  80.               End;
  81.      End;
  82.  
  83. Var
  84.    i : Word;
  85.    Mem2Get : Word;
  86.  
  87. Begin
  88.      If Paramcount = 0 then HALT;
  89.      Assign (F,ParamStr(1));
  90.      Reset (F,1);
  91.  
  92.      BlockRead (F,Header,SizeOf(TPCX_Header));
  93.      Width  := (Header.XMax - Header.XMax)+1;
  94.      Height := (Header.YMax - Header.YMin)+1;
  95.      Bytes_Per_Line := Header.Bytes_Per_Line;
  96.      For i := 0 To 479 Do Line_Table[i] := i*80;
  97.  
  98.      Mem2Get := FileSize(F) - FilePos(F);
  99.      GetMem (PcxData,Mem2Get);
  100.      BlockRead (F,PcxData^,60000,NuRead);
  101.  
  102.      SetMode ($12);
  103.  
  104.      For i := 0 To (Height-1) Do Decode_PCX_Line (i);
  105.  
  106.      Readln;
  107.  
  108.      FreeMem (PcxData,Mem2Get);
  109.      SetMode (3);
  110.      Close (F);
  111. End.
  112.